COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C ***** SCANNER *************************  
C00029 ENDMK
C⊗;
C ***** SCANNER *************************  
C* SCANR,BGSORT,FMT,RANR,SQYY,COLTTY,READER,CLEAN,ACCEL,POINTR,PARAM,ALL  7/78
	SUBROUTINE SCANR
	COMMON /PCIP/ PCH(27,102),IPT(27,101)
	COMMON/P/P(1) /PL/PL(1) 

	DIMENSION IP(1)
	COMMON J,L,CNT(27),BT,MK,DF,DUR(27)
	1/E/IQ(27),ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
	1 ,INP(145),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
	EQUIVALENCE(IF,ISCA(6)),(ISS,ISCA(9)),(IE,ISCA(5)),(IDOT,IDAT(11))
	1 ,(IEN,ISCA(4)),(IP,PL),(I0,IDAT),(I9,IDAT(10)),(IPP,ISCA(2))
C 2/74 IP IS NOW EQUIV TO PL!  USED TO BE IP WITH P.(HURT 'TAP' ROUTINE.)
C  WILL THIS DO ANYTHING TO MUSIC5 VERSION??
      NNUM=-1     
      ISKP=0
      JJ=0  
	XMINUS=1.    
	KPAR=0
999      IDECI=-1  
      M=0   
2799	N=INP(ML)
	IF(N.NE.IQT)GO TO 899
	JA=-1
	ML=ML+1
	ISUB=8
	JJ=JJ+1
	VX(JJ)=ML
C  POINTS TO FIRST LIT. CHAR.
	DO 1177 K=ML,144
	IF(INP(K).NE.IQT)GO TO 1177
	ML=K+1
2177	N=INP(ML)
	GO TO 899
1177	CONTINUE
C  SKIPS 'LIT' ITEMS IN RAN. SELECTION
899   ML=ML+1
	IF(N.EQ.':')GO TO 751
	IF(N.EQ.ISEMI)GO TO 751
	IF(N.NE.IBLA)GO TO 510
4702      IF(ISKP)202,2799,2799

510	IF(N.NE.IPP)GO TO 4511
C CATCH PARAM NUMS. GO UP AND CHANGE TO MAGIC NUMBER.
	K=INP(ML)
	IF(K.LT.I0.OR.K.GT.I9)GO TO 4511
	KPAR=-1
	JA=0
C JA=0 SO SCANR WILL FIND NOTES OR NUMS LATER.
	GO TO 2177
4511	IF(JA)GO TO 70
CCCC510	IF(JA)GO TO 70
C********** MAY 22,71
      DO 77 K=1,12   
      IF(N.NE.ISCA(K))GO TO 77
	IF(K.EQ.2)GO TO 1511
CX 	IF(K.NE.2)GO TO 1510
C P=PROXIMITY MODE -- OR A PARAM NUM.
CX3511	N=INP(ML)
CX	IF(N.GE.I0.AND.N.LE.I9)GO TO 2511
CCCC	IF(N.LT.I0.OR.N.GT.I9)GO TO 1511
CX	IF(JA.GE.0)CALL ERR(6)
C ERROR IF NO NUM AFTER P WHEN ONLY NUMS ARE EXPECTED.
CX	GO TO 1511
CX2511	KPAR=-1
C FINDS PARAMETER NUMBER (E.G. P13) USED AS A SIMPLE NUMBER. (KPAR IS FLAG)
CX	GO TO 2177
1510	IF(K.NE.4)GO TO 511
C K=2=P, =4=O ('ORDINARY')
1511	NSWCH=K-4
	GO TO 2177
C  TO SWITCH ALWAYS USE OCT.#  /PBF4/  /OE5/  P=PROXIMITY, O=ORDINARY
C ************ MAY 22,71
511   NNUM=K
	JJ=JJ+1
	NFLG=-1
	N=INP(ML)
	IF(N.NE.IF)GO TO 410
	NNUM=NNUM-1
	GO TO 610
410	IF(N.NE.ISS)GO TO 3410
	NNUM=NNUM+1
610	ML=ML+1
	N=INP(ML)
3410	IF(N.EQ.IEN)GO TO 3411
	IF(N.NE.'I')GO TO 371
C  'END' OR 'FINE' WILL END INST.
C******** MAY 20,71
3411	VX(JJ)=-10000.
CIRC3411	VX(JJ)=10000.
	IF(DUR(LK))DUR(LK)=10000.
	IAMP=-1
	RETURN
371	IF(N.EQ.ISEMI)GO TO 5410
	IF(N.EQ.IBLA)GO TO 5410
	DO 177 KN=1,10
	IF(N.NE.IDAT(KN))GO TO 177
CC	IF(KN.GE.9)CALL ERR(4)
C FOUND OCTAVE NUM. >8 -- TOO HIGH!	***** OK TO 9 NOW 7/78
	JSCA=KN-1
CC	JSCA=KN-2
	ML=ML+1
	GO TO 2410
177	CONTINUE
	GO TO 6410
5410	KN=-1
6410	IF(NSWCH.EQ.0)GO TO 2410
	IF(KN)GO TO 7410
CC	IF(N.EQ.'+')NOLD=NOLD+6
CC	IF(N.EQ.'-')NOLD=NOLD-6
C /B/B-/ JUMPS DOWN OCT., /B/B+/ UP OCT.
7410	IF(NOLD-NNUM.LE.5)GO TO 7411
	IF(JSCA.LT.7)JSCA=JSCA+1
7411	IF(NOLD-NNUM.GE.-5)GO TO 2410
	IF(JSCA.GT.0)JSCA=JSCA-1
C   WILL JUMP TO NEAREST NOTE ***********  MAY 22,71
2410	VX(JJ)=JSCA*12+NNUM
CCC2410	VX(JJ)=JSCA*12+NNUM
	NOLD=NNUM
C ********** MAY 22,71
4410	NNUM=-2
	IF(INP(ML).EQ.ISEMI)RETURN
C   ABOVE FINDS SCALE NOTES; IF NSWCH=0 OCT. NUM WILL STICK UNTIL RESET
	IF(N.EQ.IXX)GO TO 210
	IF(N.EQ.'*')GO TO 210
	GO TO 310
C *********MAY 22,71
77    CONTINUE    
70    IF(N.NE.'-')GO TO 71   
      XMINUS=-1.   
      GO TO 2799   
210	JJ=JJ+1
	IF(JJ.EQ.1)GO TO 3310
C****** MAY 19,71
	XMINUS=1.
	VX(JJ)=0
C  'X N1,N2' MAY REPLACE 'REP N1,N2'.  N2=0 BECOMES N2=2
	GO TO 310
71	IF(N.EQ.IXX)GO TO 210
	IF(N.EQ.'*')GO TO 210
	IF(N.EQ.'R')GO TO 73     
CXX	IF(N.EQ.IPP)GO TO 3511
C CATCH PARAM NUMS. GO UP AND CHANGE TO MAGIC NUMBER.

1410  DO 78 K=1,11
      IF(N.NE.IDAT(K))GO TO 78
	ISKP=-1
	IF(N.NE.IDOT)GO TO 79
	IDECI=M
	GO TO 75
79    M=M+1 
      IP(M)=K-1   
	GO TO 75
78	CONTINUE
	IF(N.NE.IE)GO TO 8811
	IF(INP(ML).NE.IEN)GO TO 781
	GO TO 7811
8811	IF(N.NE.IF)GO TO 781
	IF(INP(ML).NE.'I')GO TO 781
C  'EN(D)' OR 'FI(NE)' WILL END INST.
7811	JJ=1
	GO TO 3411
781	IF(N.EQ.'/')N=ISEMI
C   FOR MOTIVIC TRANFORMATIONS

75	KN=INP(ML)
CXX	IF(KN.NE.'R')GO TO 275
CXX	IF(INP(ML+1).NE.IE)GO TO 175
C  NOW FOUND A 'REP'
CXX	ML=ML+2
CXX	GO TO 202
275	IF(KN.NE.IXX)GO TO 175
CC	IF(INP(ML+1).NE.'(')GO TO 202
C  "X(" STARTS A 'MOTIF' BUT "X (" WON'T WORK!!!!
	IF(M.NE.0)GO TO 202
175	IF(KN.EQ.'*')GO TO 202
C  FOR 2X3, 2*3, ETC.    CHECK THIS OUT.  6/74
CC75	IF(INP(ML).NE.IXX)GO TO 752
CC	ML=ML-1
CC	GO TO 202
C  FOR 'X' AND '*' WITHOUT SPACES.
	IF(N.EQ.ISEMI)GO TO 751
	IF(KN.EQ.IQT)GO TO 751
C SO YOU CAN TYPE .5"F7"  ETC.  (NO SPACE)
	IF(KN.NE.1)GO TO 2799
C WHEN IS INP(ML) (I.E. KN) SET TO 1?????
751	IF(ISKP.EQ.0)RETURN
202   IF(IDECI.NE.-1)GO TO 302    
      IDECI=0     
      GO TO 402   
302   IDECI=M-IDECI     
402   KN=0  
      IEXP=M-1    
      IF(M.LT.1)M=1     
      DO 171 K=1,M
	KV=10**IEXP
	IF(IEXP.EQ.0)KV=1
      KN=KN+IP(K)*KV 
171     IEXP=IEXP-1     
      A=10**IDECI 
	IF(IDECI.EQ.0)A=1.
	JJ=JJ+1
	A=KN/A*XMINUS
CC	VX(JJ)=KN/A*XMINUS
	IF(KPAR.EQ.0)GO TO 172
	A=-9999.-A/100.
	KPAR=0
C CHANGES P13 TO -9999.13, FOR EXAMPLE.
172	VX(JJ)=A
	IF(ISUB.EQ.1)RETURN
	IF(CODE.NE.-22.)XMINUS=1.
C  ONLY ONE - NEEDED FOR RHY.COMPOSITE
1310	IF(INP(ML).NE.1)GO TO 310
	VX(JJ+1)=VX(JJ)*2.
	JJ=JJ+1
	ML=ML+1
	GO TO 1310
206	ML=ML+2
3310	VX(1)=-99.
C******** MAY 19,71
310      ISKP=0
        IF(N.NE.ISEMI)GO TO 999

    	RETURN
73	JJ=JJ+1
	 IF(INP(ML).EQ.IE)GO TO 206    
C   NEXT IS FOR A REST ('R')  
      VX(JJ)=199.
CCC   VX(JJ)=85.
C 7/75	GO TO 4410
731	N=INP(ML)
	IF(N.EQ.'/')RETURN
	IF(N.EQ.ISEMI)RETURN
	IF(N.NE.IBLA)GO TO 899
	ML=ML+1
	GO TO 731
  	END

	SUBROUTINE BGSORT(BW)
C  THIS SORTS BG TIMES SO NONE ARE DUPLICATED IN BNW ARRAY.
C  ALLOWS 100 BG TIMES.
	COMMON /Q/ BNW(200),NWZ
C****NEEDS TRAP FOR EXCEEDING 200 LIMIT ⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗
	DO 5308 K=1,NWZ
	X=BNW(K)-.0001
	Y=X+.0002
C   ROUND-OFF NONSENSE
	IF(BW.LE.X)GO TO 5308
 	IF(BW.LT.Y)RETURN
5308	CONTINUE
	NWZ=NWZ+1
	BNW(NWZ)=BW
	RETURN
	END

	SUBROUTINE FMT(JFM,INP,MLX)
	DIMENSION JFM(3),INP(1)
	DO 1 MLX=2,72
	J=INP(MLX)
	IF(J.EQ.'	')J=' '
C ABOVE FINDS A TAB, CHANGES IT TO BLANK SPACE
	IF(J.EQ.' ')GO TO 2
	IF(J.EQ.',')GO TO 2
	IF(J.EQ.';')GO TO 2
1	CONTINUE  
C*** TEMPORARY CHANGE ***** IF(J.EQ.':')GO TO 3
C  SPACE=COMMA=SPACE, ALSO STOPS ON ";"
3	CALL ERR(1)
C  ERROR IF COLON IS FOUND OR THERE IS NO END MARK 
2	MLX=MLX+1
	IF(MLX.GT.7)MLX=7
	JFM(2)='0'+(MLX-2)*536870912
C   FINDS NUMBER FOR 'A' FORMAT
	END

      SUBROUTINE RANR(VX,K)
C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE AND ADDS .999
      DIMENSION VX(1)
CC    X=VX(K)
CC    Y=VX(K+1)
CC    IF(X.GT.Y)VX(K)=X+.999
CC    IF(Y.GE.X)VX(K+1)=Y+.999
	J=K+1
	IF(VX(K).GT.VX(K+1))J=J-1
	IF(VX(J).GT.-9999.)VX(J)=VX(J)+.999
C AVOID TAMPERING WITH PARAM NUMS.
      END

      SUBROUTINE SQYY(YY,X,Y,Z)
      YY=2.*Z/(X+Y)
      IF(YY.NE.0)YY=2.*(Z-X*YY)/YY**2
      RETURN
      END

	SUBROUTINE COLTTY(JNP,JT)
	COMMON /TYP/SOS,JOUT,LN,ITYP,TPALN(4),JED /FRMT/J(2)
	DIMENSION JNP(1)
	DATA J(2)/'80A1)'/
	DO 1 K=72,1,-1
	JJ=JNP(K)
1	IF(JJ.NE.' '.AND.JJ.NE.'	')GO TO 2
C SECOND SPACE IS A TAB.
	K=1
2	IF(JT.EQ.21)GO TO 3
	J(1)='  (1X'
	IF(LN.EQ.0)GO TO 5
	J(1)='(I6,X'
	WRITE(JT,J)LN,(JNP(L),L=1,K)
	RETURN
3	J(1)='    ('
5	WRITE(JT,J)(JNP(L),L=1,K)
	END

	FUNCTION READER(JNP)
	DIMENSION JNP(80)
	COMMON /TYP/SOS,JOUT,LN,ITYP,TPALN(4),JED
	1 /FRMT/J(2)  /IFI/IFI
	DATA TPALN/20H(' TYPE A LINE'/)   /
	J(1)='    ('
	READER=0
	IF(ITYP)GO TO 1
6 	TYPE TPALN
	ACCEPT J,JNP
	IF(JED)CALL COLTTY(JNP,21)
	GO TO 8
1	IF(IFI)GO TO 5
CIRC1	IF(LN.NE.0)GO TO 5
	READ(23,J,END=3)JNP
	GO TO 7
3	READER=-1
	GO TO 8
5	J(1)='  (I,'
	READ(23,J,END=3)LN,JNP
7	IF(SOS)CALL COLTTY(JNP,JOUT)
8	IF(JNP(1).EQ.'	')JNP(1)=' '
C CHANGES TAB TO SPACE ABOVE.
	END

	SUBROUTINE QUAD
C  DUMMY -- FOR NOW.  7/74
	END

	FUNCTION RMOVX(W,Y,Z)
	IF(W.EQ.0)W=.01
	IF(Y.EQ.0)Y=.01
	RMOVX=Y*((W/Y)**Z)
	END

	SUBROUTINE CLEAN(LEND)
	COMMON /E/IQ(27),ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,ISUB,NFLG,
	1 IXX,ISEMI,IQT
	1 ,INP(145),VX(70),ISCA(12),IDAT(11),IAMP,J,KN,O,ML,CODE,IBLA
C  CLEAR THE END OF ARRAY
	M=72
	LEND=-1
	K=0
	DO 10 LL=73,80
	IF(INP(LL).EQ.' ')GO TO 10
C THIS 'ERR' IS JUST A WARNING
	CALL ERR(11)
	GO TO 1
10	CONTINUE
1	K=K+1
	NN=INP(K)
	IF(NN.EQ.';')GO TO 2
	IF(NN.EQ.'/')GO TO 2
	IF(NN.EQ.'<')GO TO 3
CCC	IF(NN.NE.'<')GO TO 5
CCC	INP(K)=' '
CCC	GO TO 3
C  USE < FOR COMMENT--  AS IN MUS10
5	IF(NN.EQ.','.OR.NN.EQ.'	')INP(K)=' '
CHANGE ALL COMMAS AND TABS TO BLANKS(IT LOOKS LIKE A BLANK ABOVE, BUT ISN'T)
C**** FOR CHORD FEATURE 	IF(NN.EQ.':')CALL ERR(1)
8	IF(NN.NE.'"')GO TO 4
7	K=K+1
	IF(INP(K).EQ.'"')GO TO 4
	IF(K.LT.M)GO TO 7
	CALL ERR(5)
2	LEND=K
4	IF(K.LT.M)GO TO 1
3	IF(LEND.GT.0)RETURN
	IF(M.EQ.145)CALL ERR(2)
C LINES STARTING WITH P OR C CAN POSSIBLY HAVE NO SEMICOLON IN THEM.
CC	IF(INP(1).NE.'P'.AND.INP(1).NE.'C')CALL ERR(2)
6	CALL READER(INP(74))
C  GO READ ANOTHER LINE.
	M=INP(74)
	IF(M.GE.'A'.AND.M.LE.'Z')CALL ERR(2)
C ONE EXTRA SPACE (M=145, NOT 144) FOR THE CRLF.
	M=145
	K=72
	INP(73)=' '
	GO TO 1
	END

	SUBROUTINE ERR(K)
	COMMON /ERRFLG/ERRFLG /TYP/SOS,JOUT /E/IQ(27),ISKP,XMINUS,N,
	1 IEXP,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT,INP(74)
	IF(SOS.EQ.0)TYPE 999,INP
	GO TO(1,2,3,4,5,6,7,8,9,10,11,12,13)K
	TYPE 199,K
199	FORMAT(' ***** ERROR!!  SOMEWHERE UP TO HERE. ***-FATAL-***'/)
	GO TO 200
1	TYPE 101
	GO TO 200
101	FORMAT(' ***** COLON WANTED HERE? ***-FATAL-***'/)
CCC11	FORMAT(/' ILLEGAL COLON')
2	TYPE 102 
	GO TO 200
102	FORMAT(' ***** NO END MARK OR SEMICOLON ***-FATAL-***'/)
3	TYPE 103
	GO TO 200
103	FORMAT(' ***** MORE THAN 2 PARENS OPEN ***-FATAL-***'/)
4	TYPE 104
	GO TO 200
104	FORMAT(' ***** SOME NUMBER OUT OF BOUNDS ***-FATAL-***'/)
5	TYPE 105
	GO TO 200
105	FORMAT(' ***** OPEN QUOTES ***-FATAL-***'/)
6	TYPE 106
	GO TO 200
106	FORMAT(' ***** PARAM NUMBER ERROR: >99 ***-FATAL-***'/)
7	TYPE 107
	GO TO 200
107	FORMAT(' ***** TOO MANY INSTS ***-FATAL-***'/)
8	TYPE 108
	GO TO 200
108	FORMAT(' ***** MOTIVE ERROR ***-FATAL-***'/)
9	TYPE 109
	GO TO 200
109	FORMAT(' ***** "MOVE" ERROR ***-FATAL-***'/)
10	TYPE 110
	GO TO 200
110	FORMAT(' ***** MISSING "*"   ***-FATAL-***'/)
11	TYPE 111
	RETURN
111	FORMAT(' **** WARNING: CHARACTERS FOUND BEYOND COLUMN 72'/)
12	TYPE 112
	GO TO 200
999	FORMAT(1X74A1)
112	FORMAT(
     1' ***** WRONG NUM. OF ELEMENTS IN RAN. SELECTION. ***-FATAL-***'/)
13	TYPE 113
113	FORMAT(' ***** WRONG FORMAT FOR P2. ***-FATAL-***'/)
200	ERRFLG=-1
C THIS WILL CAUSE EXIT BEFORE 'RUNIT'.
	END

	SUBROUTINE ACCEL
	COMMON /PCIP/ PCH(27,102),IPT(27,101)
	COMMON/P/P(1) /PL/PL(1)

	COMMON/VV/LIMIT,V(1)/A/ROFF(27),NP(27),
	1 RDEV(27),XT(27),OTH(20,16),P1(27),JFM(4),IFM(80)
	1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
	COMMON J,L,CNT(27),BT,MK,DF,DUR(27)
	1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
	1 ,INP(145),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
	COMMON/B/MOT,PR,T5,NINS,I,RA,KZY,NWX,INONLY,MX,
	1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
	1 ZZ,CHN,YY 
	1 /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
	1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
	1 LP,ILIT,NLIT,KTMP,IC,NONO,RD,IA
C  /C/=26
      IF(T5.EQ.1)GO TO 4020
	XA=RA
7020  RA=V(IA+K)
      IF(RA.EQ.-10000.)RETURN
4020  RD=1  
      IF(RA.LT.0)RD=-1. 
      RA=RA*RD    
      IF(KA.EQ.0)RA=RA-RC     
      W=RA  
      RB=W  
      IF(W.LE.Z-.0001)GO TO 2020    
C .0001 FOR ROUND-OFF ERRORS!!!!!!!
      IF(Z.NE.0)GO TO 3020    
      RA=RA/Y     
      RB=-1.
      RC=0  
      GO TO 8020  
3020      W=Z     
      RC=W+RC     
      GO TO 24    
2020      RC=0    
24	IF(X.NE.Y)GO TO 424
	RA=W/X
	GO TO 8020
C   DUR OF TMP + BG TIME OF TMP - NOTE VALUE - 
C   BG TIME OF NOTE. CHN=TBG.
424	RAX=XT(J)
	RA=(-2.*RAX+(4.*RAX**2+8.*YY*W)**.5)/(2.*YY)
	XT(J)=RAX+YY*RA
8020      IF(KA.EQ.0)RA=RA+XA 
      KA=1  
CXX   IF(RC.NE.0)GO TO 1011   
CCXX  IF(T5.EQ.1)RETURN
	IF(T5.NE.1)GO TO 1012
	IF(RC.NE.0)GO TO 2011
	RETURN
C  T5=1 IN 'RUNIT'
1012  V(IA+K)=RA*RD     
      IF(K.EQ.IZ)RETURN     
C*********** JUNE 1,71
1011      IF(T5.EQ.1)GO TO 2011     
      K=K+1 
      IF(ZZ.NE.0)Z=Z-W  
      IF(Z.GT.0)GO TO 7020
	IF(RB.EQ.-1.)GO TO 7020     
      IC=IC+1     
      IF(RB.EQ.W)RETURN
      KA=0  
      K=K-1 
      RETURN
2011      XA=RA   
	IF(K.GT.1)GO TO 9020
	K=I-6
      ZPAR=-9900.-CHN-ZZ
      DO 3011 KL=8,I     
      IF(V(K).NE.ZPAR)GO TO 3011
	IF(V(K+1).EQ.990000.)GO TO 9020    
3011      K=K-1
9020      W=ZZ  
	IF(V(K+3))K=K+3
C   ABOVE IS FOR TYPED IN TEMPO CHANGES
	KA=K+3
      ZZ=V(KA)
C   DUR OF NEXT TEMPI
	X=V(KA+1)
	Y=V(KA+2)
213      KA=0  
      Z=ZZ  
	CALL SQYY(YY,X,Y,Z)
      CHN=CHN+W   
	XT(J)=X
      IF(KA.EQ.1)Z=0    
      RA=PR 
	KA=0
	K=K+3
	GO TO 4020
	END

	SUBROUTINE POINTR(INUM,IPAR,ISTRT,KODE)
	COMMON/VV/LIMIT, V(2000)
C  TO FIND POINTERS TO LISTS, ETC. IN V ARRAY WHEN USING SUBR.
C KODES:  -22=RHY  -33=NOTES  -44=NUMS  -46=RLIST  -36=RNOTES
C   -11=SUBN  -12=SUBR  -55=MOVE NUMS  -56=MOVE NOTES
C  -66=DUPL   -88=LIT  -57=MOVE RANGE NUMS  -58=MOVE RNG NOTES
	DO 1 K=1,2000
	N=V(K)
	IF(N.LT.10000)GO TO 1
	IF(N/10000.NE.INUM)GO TO 1
	IF(MOD(N,10000).NE.IPAR)GO TO 1
	ISTRT=K+4
	KODE=V(K+2)
	ICNT=V(K+3)
	IF(IABS(KODE).LT.11)ISTRT=ISTRT-1
	RETURN
C  FINDS FIRST OCCURRENCE OF PARAM AND INST ONLY.
1	CONTINUE
	END

CC	SUBROUTINE NMCHG
CC	DIMENSION RNAME(5),JNM(5)
CC	COMMON /INS/ INST(27),BG(60)
CC	COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
CC	COMMON/VV/LIMIT, V(1) /C/T,NWZZ,IT3,T6,NW,TDUR,A,T2,T4,IL
CC	1,KODE,NPAR,LP,TBG,AC,NPA,BX,IDF,PM,NM,PAR,PX2,T1,RD,VIJ2
CC	EQUIVALENCE (RNAME,JNM)
CC	DATA KK/128/,LL/"377777777777/,JJ/"2000000000/
CC	DATA MM/"774000000000/

CC	P(IPAR)=0
C REPLACE NAME BY A ZERO FOR THIS PARAM.
CC	PL(IPAR)=1.
CC	J=PM-1
C PM POINTS TO 1ST WORD OF LIT. STRING., PAR= LAST
CC	N=V(J)
C  THE WORD COUNT
CC	DO 15 K=1,5
CC	J=J+1
CC	X=V(J)
CC	IF(K.GT.N)X=' '
CC15	RNAME(K)=X
C N=WDCNT OF INST NAME
CC	NN=0
CC	DO 10 K=5,1,-1
CC	NN=NN .OR. (JNM(K) .AND. MM)
CC	IF (K-1) 20,20,17
CC17	IF (NN.GE.0)GO TO 13
CC	NN = (( NN .AND. LL)/KK) .OR. JJ
CC	GO TO 10
CC13	NN = NN / KK
CC10	CONTINUE
CC20	INST(INUM)=NN
CC	END
 
	SUBROUTINE SHORT(KNP,K)
C  DON'T TYPE TRAILING BLANKS
	DIMENSION KNP(1)
	DO 1 K=15,1,-1
1	IF(KNP(K).NE.' ')RETURN
	K=1
	END

C***** THIS IS NOW A 'FAIL' ROUTINE IN SPRINT.FAI
CC	FUNCTION PARAM(X,K)
CC	COMMON J,L  /P/P(1) /PL/PL(1) /C/T,NWZZ,IT3,T6,NW,TDUR,A,
CC	1 T2,T4,BY,KODE,NPAR,LP,TBG,AC,NPA,BX,IDF,PM,NM,PAR,PX2
CC	K=0
C IF K IS NOT ZERO UPON RETURN, THEN WE'VE FOUND INFO IN OTHER PARAM.
CC	PARAM=X
CC	IF(X.GT.-9999.0)RETURN
CC	IF(X.EQ.-10000.0)RETURN
CC	K=-(X+9999.0)*100.+.1	
CC	PARAM=P(K)
C GET DATA FROM PARAM K
CC	PM=PL(K)
CC	IF(L.NE.2)RETURN
C L=CALLING PARAM NUM., K=PARAM REFERRED TO.
CC	IF(K.EQ.2)PARAM=PX2
C MUST USE 'UNPROCESSED' FORM OF P2 (I.E. NO 'TEMPO' CHANGES)
CC	END
	
C***** MICROTONES ********
	SUBROUTINE MICRO
	COMMON INUM,IPAR  /P/P(1) /PL/PL(1) 
C   CALL SUBROUTINE FROM ANY PARAMETER WHERE THE CALLING PARAMETER
C   AND THE IMMEDITELY PRECEDING PARAMETER ARE UNUSED BY YOUR INSTR.
C   P3 CAN BE NOTES OR NUMBS.

	X=P(3)
	IF(PL(3).EQ.1)GO TO 1
CC	X=IFIX(X)
C  FOR RAND NOTES TO LOCK ON NOTE NUMBERS.
CC	X=30.8677*2**(X/12)
	X=15.43385*2**(X/12)
C  X=FREQ. IN HZ. BASED ON NT # IN P3.  NUM. ABOVE IS B, IE. LOWEST B -1 OCT.
	PL(3)=1.
C  THIS CAUSES FREQ. NUM TO PRINT INSTEAD OF LITERAL CHARACTERS.

1	Y=IFIX(P(IPAR-1))
	Z=IFIX(P(IPAR))
C FIX NEEDED BECAUSE OF POSSIBLE NON-INTEGERS HERE.
	P(3)=X*2**(Y/Z)
C  IPAR (Z) IS THE CALLING PARAMETER.  IPAR-1 (Y) THE PREVIOUS PARAM.
C  X HAS BASE FREQ.
C  THE NUMBER IN P(IPAR)=# OF DIVISIONS OF THE OCTAVE.  
C  THE NUMBER IN P(IPAR-1)=CHROMATIC STEP IN THAT DIV.
	END

	FUNCTION ALL(JPT,IPTX)
	COMMON /VV/LIMIT,V(1)
	DIMENSION JPT(1)
	K=IPTX-1
	IF(K.GT.0)GO TO 2
1    	K=JPT(-K)
	IF(K)GO TO 1
C  FOR 'ALL' WITH RR,RD,DF.  FOLLOWS UP ON POINTERS TO POINTERS!
	K=K-1
2	ALL=PARAM(V(K+3),K)
	END

C THIS ROUTINE ALLOWS NAMES OF FROM 1 TO 5 LETTERS TO BE USED.
C NO EXTENSIONS CAN BE USED.  INF RETURNS INFO REL LINE NUMS.
CC	SUBROUTINE IFILE(I,N,INF)
CC	EQUIVALENCE (NN,NAME),(NN2,NN(2))
CC	COMMON /NN/NN(2)
CC	DOUBLE PRECISION NAME
CC	DATA NN(2)/'.'/
CC5	INF=0
CC	NN(1)=N
CC	OPEN(UNIT=I,FILE=NAME)
CC	IF(NN2.NE.'.')GO TO 1
C JUMP IF COMING FROM OFILE CALL
CC	READ(I,2)K,J
CC	IF(K.NE.'00')GO TO 3
CC	INF=-1
C INF = -1  = LINE NUMBERS.
CC6	OPEN(UNIT=I,FILE=NAME)
C REOPEN IF LINE NUMS OR NO "COMMENT"
CC	GO TO 1
CC3	IF(K.NE.'CO')GO TO 6
CC	IF(J.NE.'MMENT')GO TO 6
CC4	READ(I,2)K,J
C READS COMMENTS ON DIRECTORY PAGE.
CC	IF(J.NE.';')GO TO 4
CC2	FORMAT(A2,A5)
CC1	NN2='.'
CC	END
CC	SUBROUTINE OFILE(I,N,IEXT)
CC	COMMON /NN/NN1,NN2
CC	NN2=IEXT
CC	CALL IFILE(I,N,INF)
CC	END